home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
4cmp22s.zip
/
DEFINING.4TH
< prev
next >
Wrap
Text File
|
1994-10-30
|
4KB
|
134 lines
\ ForthCMP Defining Word Examples
\ COPYRIGHT (C) 1994 BY THOMAS ALMY. ALL RIGHTS RESERVED
\ Permission is granted to registered users of ForthCMP to sell or distribute
\ computer programs incorporating the compiled contents of this file.
\ THIS FILE CONTAINS DEFINING WORD EXAMPLES FOR TWO DIMENSIONAL
\ VECTORED ARRAYS, VARIABLES IN ROM SPACE, AND PRINTING IN
\ SPECIFIC BASES.
100 MSDOS \ select one of these
\ 10000 100 MSDOSEXE
\ 2 Dimensional Integer Array 06/26/94
SEPDSEG? [IF] ( handle romable and ram versions differently )
PRIMITIVE ( defined arrays are primitive )
H: ARRAY2D ( rows columns --- )
CSEG CREATE \ header & vector in CSEG
SWAP 0 DO \ build vector
DSEG HERE , \ pointer to row
DUP CELLS ALLOT \ row allocated in DSEG
LOOP DROP
DOES> ( row# column# -- address )
ROT CELLS + CS: @ \ address of row
SWAP CELLS + ; \ address of element
[ELSE]
PRIMITIVE ( defined arrays are primitive )
H: ARRAY2D ( rows columns --- )
CREATE \ header & vector
2DUP * CELLS -ROT \ remember array size
OVER CELLS HERE + ROT 0 DO \ fill in vector
DUP , OVER CELLS + LOOP
2DROP ALLOT \ allocate array space
DOES> ( row# column# -- address )
ROT CELLS + @ \ address of row
SWAP CELLS + ; \ address of element
[THEN]
\ 2 Dimensional Character Array 06/26/94
SEPDSEG? [IF] ( handle romable and ram versions differently )
PRIMITIVE ( defined arrays are primitive )
H: CARRAY2D ( rows columns --- )
CSEG CREATE \ header & vector in CSEG
SWAP 0 DO \ build vector
DSEG HERE , \ pointer to row
DUP ALLOT \ space allocated in DSEG
LOOP DROP
DOES> ( row# column# -- address )
ROT CELLS + CS: @ \ address of row
+ ; \ address of element
[ELSE]
PRIMITIVE ( defined arrays are primitive )
H: CARRAY2D ( rows columns --- )
CREATE \ header & vector
2DUP * -ROT \ remember array size
OVER CELLS HERE + ROT 0 DO \ fill in vector
DUP , OVER + LOOP
2DROP ALLOT \ allocate array space
DOES> ( row# column# -- address )
ROT CELLS + @ \ address of row
+ ; \ address of element
[THEN]
\ Variable in rom 06/26/94
H: Variable CSEG CREATE 0 , ;
0 [IF]
In programs with separate code and data segments, this creates a
variable in the code segment. Such a variable can be used at
cross-compile time and fetched at runtime. The variable can be
stored into at runtime if the code segment is in RAM memory.
[THEN]
\ Base Print 06/26/94
2 0 IN/OUT \ at runtime, two arguments: value to print and
\ the pointer to the desired numeric base
H: BASE. ( base -- )
CSEG CREATE , \ compile desired base
DOES> ( value -- )
BASE @ -ROT \ save current base
CS: @ BASE ! \ set base from parameter field
. \ print the value
BASE ! ; \ restore original base
( CS: needed only if separate data and code segments )
\ Test of array words and base print words
2 4 ARRAY2D ARRAY1 2 4 CARRAY2D ARRAY2
: ARRAYTEST 0 CR HEX
." Filling arrays" CR CR
2 0 DO 4 0 DO DUP J I ARRAY1 DUP . !
DUP J I ARRAY2 DUP . C! 1+ LOOP LOOP
DROP CR CR
." Reading arrays" CR CR
8 0 DO ['] ARRAY1 >BODY CS: @ I CELLS + @ . LOOP CR
8 0 DO ['] ARRAY2 >BODY CS: @ I + C@ . LOOP CR ;
8 BASE. O. 16 BASE. H.
: BASETEST 16 0 DO I . I O. I H. CR LOOP ;
: MAIN DECIMAL BASETEST ARRAYTEST ;
INCLUDE FORTHLIB
END